00010	BEGIN "HEAD"
00020	DEFINE ⊂="COMMENT";  ⊂ 8/28/73 Lists header info on line and in file with
00030	  extension of HDX;
00040	DEFINE ⊃="⊂"; ⊂ Change this symbol to mean "" to get running commentary;
00050	⊂ Program UPDATE is used to incorporate corrected data into the header;
00060	⊂ Program CONVER.SAI is used to convert OLDPH files to the NEWPH format
00070	    and to prepare a list of the header for manual corrections which is
00080	    called XXX.HDR;
00090	
00100	REQUIRE "BLOCKX.HDR[11,ALS]" SOURCE_FILE;
00110	INTEGER ARRAY LFILE[0:'177];
00120	INTEGER ARRAY SYMBOL[0:127];
00125	STRING ARRAY SAMPLE[0:127];
00130	INTERNAL INTEGER H,I,J,K,L,M,N,P,NF;
00140	INTERNAL INTEGER FLAG,CFLAG,RFLAG,UPCNT,TABTOT;
00150	INTERNAL INTEGER SEGC,INTOT,SEGTOT,HINT,BPT,PHW,SMOCNT,SMCNT2,ZCNT;
00160	INTEGER SUM,S1,S2,S3,S4,RL;
00170	INTEGER HINCNT,HCOUNT,HINDEX,EOF,EOFA,EOFB,BRK;
00180	INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,CHANX;
00190	STRING READ1,READ2,READ3,FILEL,FILEI,TFILE,TFILEI,FILLST,PREHINT;
00200	BOOLEAN ER;
00205	LABEL ZOUT,ZZOUT;
00210	
00220	PROCEDURE OUTALL(STRING S);
00230	BEGIN
00240	STRING SS; INTEGER J;
00250	SETBREAK(18,0,NULL,"OSN");
00260	SS←SCAN(S,18,J);
00270	OUTSTR(SS);
00280	END;
     

00010	STDBRK(1);
00020	 SETBREAK(14,"∃",NULL,"INS");
00030	 SETBREAK(15,'11&'12&'14&'15&'40,NULL,"INS");
00040	 SETBREAK(16,'56,NULL,"INA");
00050	 SETBREAK(17,'12,'15,"INS");
00060	
00070	CHAN1←1; CHAN2←2; CHAN3←3;  CHAN4←4; CHAN5←5; CHAN6←6;
00080	OUTSTR("This program will list header information in man-readable form."&crlf);
00090	
00100	CLOSE(CHAN4); OPEN(CHAN4,"DSK",1,2,0,3500,BRK,EOFA);
00110	LOOKUP(CHAN4,"MAP.PHN",ER);
00120	WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find MAP.PHN[NET,NJM].  File = ");
00130	LOOKUP(CHAN4,TFILE←INCHWL,ER); END;  EOFA←0;
00140	FILLST←INPUT(CHAN4,14);
00150	⊂ OUTSTR("MAP.PHN contains "&CRLF&FILLST&CRLF);
00160	CLOSE(CHAN4);
00170	
00180	FOR I←0 STEP 1 UNTIL 127 DO  BEGIN
00190	  WHILE TRUE DO BEGIN
00200	    READ1←SCAN(FILLST,17,K);
00210	    READ3←READ1[1 TO 1];
00220	    IF READ3≠"⊂"  THEN DONE; END;
00230	IF READ3="" THEN DONE;
00240	  SYMBOL[I]←CVASC(SCAN(READ1,15,K));
00250	  SAMPLE[I]←READ1; END;
00260	
00270	
00280	WHILE TRUE DO BEGIN "LISTREAD"
00290	OUTSTR("Data file to be used(type name or CR to terminate) ");
00295	FILEI←INCHWL;
00300	IF FILEI="" THEN DONE;
00310	CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00320	LOOKUP(CHAN4,FILEI,ER);
00330	WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find "&FILEI&" File = ");
00340	LOOKUP(CHAN4,FILEI←INCHWL,ER); END;  EOFA←0;
00350	ARRYIN(CHAN4,LFILE[0],'200);	⊂ Input header;
00360	SEGTOT←(LFILE[0]*6)%256;
00370	⊃ OUTSTR(FILEI&" "&CVS(SEGTOT)&"   ");
00380	OUTSTR(CRLF&"Symbol"&TB&"Start"&TB&"Length"&TB&"Sample"&TB&"Features"&CRLF&LF);
00390	CLOSE(CHAN4);
00400	
00410	READ2←FILEI;
00420	READ1←SCAN(READ2,16,J)&"HDX";
00430	⊃ OUTSTR("Ready to write "&READ1&TB);
00440	OPEN(CHAN4,"DSK",0,0,10,0,0,EOF);
00450	ENTER(CHAN4,READ1,0);
00460	OUT(CHAN4,"⊂ Header information from file   "&FILEI&"."&TB&TB&DATIME&CRLF);
00470	OUT(CHAN4,"⊂  Produced by program HEAD[11,ALS] and filed in  "&READ1&"."&CRLF);
00480	OUT(CHAN4,"⊂  This file may be corrected and used as input for "&
00490	      "program UPDATE[11,ALS]."&CRLF);
00500	OUT(CHAN4,"⊂ "&CRLF&"⊂ ");
00510	  FOR I←0 STEP 1 UNTIL 9 DO OUT(CHAN4,CVS(LFILE[I])&TB);
00520	OUT(CHAN4,CRLF&"⊂ ");
00530	  FOR I←10 STEP 1 UNTIL 20 DO OUT(CHAN4,CVXSTR(LFILE[I]));
00540	  OUT(CHAN4,CRLF&"⊂ "&CRLF);
00550	OUT(CHAN4,"⊂ Hint"&TB&"Start"&TB&"Length"&TB&"Example"&TB&"Features"&CRLF);
00560	FOR I←21 STEP 1 UNTIL 127 DO BEGIN
00570	  IF LFILE[I]=0 THEN IF I>0 THEN DONE ELSE BEGIN OUTSTR("No data."&crlf);
00580	    done end;
00590	  L←LFILE[I] LAND '777760000000;
00600	  FOR M←0 STEP 1 UNTIL 126 DO IF L=SYMBOL[M] THEN DONE;
00610	  J←LDB(POINT(14,LFILE[I],27)); K←LDB(POINT(8,LFILE[I],35));
00615	ZOUT:
00620	  OUT(CHAN4,CVSTR(L)&TB&CVS(J)&TB&CVS(K)&TB&SAMPLE[M]&CRLF);
00625	ZZOUT:
00635	  OUTALL(CVSTR(L)&TB&CVS(J)&TB&CVS(K)&TB&SAMPLE[M]);
00640	  OUTSTR(CRLF);
00650	  END; CLOSE(CHAN4);
00660	
00670	OUTSTR(CRLF&"File "&READ1&" has been written."&CRLF&LF);
00680	OUTSTR("Do you want it spooled (Y or CR) ");
00685	IF INCHWL="Y" THEN
00690	  SPOOL(READ1,GETCHAN,0);
00700	END "LISTREAD";
00710	RELEASE(CHAN1); RELEASE(CHAN2); RELEASE(CHAN3); RELEASE(CHAN4);
00720	
00730	END "HEAD";